home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / euphoria / mydata.ex < prev    next >
Text File  |  1994-02-11  |  7KB  |  280 lines
  1. ----------------------- Simple Customizable Database -----------------------
  2.  
  3. -- files to store the database and a backup copy:
  4. constant DB_NAME   = "mydata.dat",
  5.      BACK_NAME = "mybackup.dat"
  6.  
  7. constant FIELDS = {  -- Have as many fields as you like. The first one is 
  8.              -- used for look-ups. Start a new database if you
  9.              -- change or add fields.
  10. -- example fields:
  11.     "Surname",
  12.     "First name and initial",
  13.     "Phone number"
  14.     }
  15.  
  16. ----------------------------------------------------------------------------
  17. -- How it works:
  18. --
  19. -- The database is just a big Euphoria sequence that is read from
  20. -- a disk file using get(), updated in memory, then written back
  21. -- to the file using print().
  22. --
  23. -- For small amounts of data (up to about a thousand records) this works fine. 
  24. -- For very large databases we would want to use the random access I/O 
  25. -- functions: seek() and where(), to read/write only a specific portion
  26. -- of the data each time.
  27. ---------------------------------------------------------------------------- 
  28.  
  29. include get.e
  30. include sort.e
  31.  
  32. constant KEYBOARD = 0,
  33.      SCREEN   = 1,
  34.      ERROR    = 2
  35.  
  36. constant TRUE = 1
  37. constant WHITE_SPACE = " \t\n"
  38. constant FORM_FEED = 12
  39.  
  40. type file_number(integer x)
  41.     return x >= -1
  42. end type
  43.  
  44. type record(sequence s)
  45.     return length(s) = length(FIELDS)
  46. end type
  47.  
  48. file_number db    -- number of file containing database
  49.  
  50. sequence database -- the in-memory database
  51.  
  52. type record_number(integer x)
  53.     return x >= 0 and x <= length(database)
  54. end type
  55.  
  56. procedure error(sequence msg)
  57. -- fatal error
  58.     puts(ERROR, '\n' & msg & '\n')
  59.     abort(1)
  60. end procedure
  61.  
  62. function user_input()
  63. -- get user input from keyboard
  64.     object line
  65.  
  66.     while TRUE do
  67.     line = gets(KEYBOARD)
  68.     if sequence(line) then
  69.         -- delete any leading whitespace
  70.         while find(line[1], WHITE_SPACE) do
  71.         line = line[2..length(line)]
  72.         if length(line) = 0 then
  73.             exit
  74.         end if
  75.         end while
  76.         if length(line) > 0 then
  77.         exit
  78.         end if
  79.     end if
  80.     puts(SCREEN, "\n? ")
  81.     end while
  82.     -- delete trailing whitespace
  83.     while find(line[length(line)], WHITE_SPACE) do
  84.     line = line[1..length(line)-1] 
  85.     end while
  86.     return line
  87. end function
  88.  
  89. procedure show(file_number f, record rec)
  90.     puts(f, "\n" & rec[1] & '\n')
  91.     for i = 2 to length(FIELDS) do
  92.     puts(f, '\t' & rec[i] & '\n')
  93.     end for
  94. end procedure
  95.  
  96. function upper(sequence name)
  97. -- convert to upper case
  98.     for i = 1 to length(name) do
  99.     if name[i] >= 'a' and name[i] <= 'z' then
  100.         name[i] = name[i] + 'A' - 'a'
  101.     end if
  102.     end for
  103.     return name
  104. end function
  105.  
  106. function lookup(sequence name)
  107. -- return record numbers matching name
  108.     sequence matches
  109.     
  110.     matches = {}
  111.     name = upper(name)
  112.     for i = 1 to length(database) do
  113.     if compare(name, upper(database[i][1])) = 0 then
  114.         matches = matches & i
  115.     end if
  116.     end for
  117.     return matches
  118. end function
  119.  
  120. procedure db_add()
  121. -- add a new record to the database
  122.     record rec
  123.     sequence matches
  124.  
  125.     rec = repeat(0, length(FIELDS))
  126.     puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
  127.     rec[1] = user_input()
  128.     matches = lookup(rec[1])
  129.     for i = 1 to length(matches) do
  130.     show(SCREEN, database[matches[i]])
  131.     end for
  132.     for i = 2 to length(FIELDS) do
  133.     puts(SCREEN, "\n\t" & FIELDS[i] & ": ")
  134.     rec[i] = user_input()
  135.     end for
  136.     puts(SCREEN, '\n')
  137.     database = append(database, rec)
  138. end procedure 
  139.  
  140. procedure db_delete()
  141. -- delete a record, given first field 
  142.     sequence name, answer
  143.     record_number rec_num
  144.     sequence matches
  145.     integer i
  146.  
  147.     puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
  148.     name = user_input()
  149.     matches = lookup(name)
  150.     if length(matches) = 0 then
  151.     puts(SCREEN, "\n\tnot found\n")
  152.     return
  153.     end if 
  154.     i = 1
  155.     while i <= length(matches) do
  156.     show(SCREEN, database[matches[i]])
  157.     puts(SCREEN, "Delete? ")
  158.     answer = gets(KEYBOARD)
  159.     if find('y', answer) then
  160.         rec_num = matches[i]
  161.         database = database[1..rec_num-1] & 
  162.                database[rec_num+1..length(database)]
  163.         exit
  164.     end if
  165.     i = i + 1
  166.     end while
  167. end procedure
  168.  
  169. procedure db_find()
  170. -- find all records that match value of first field
  171.     sequence name, matches
  172.  
  173.     puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
  174.     name = user_input()
  175.     matches = lookup(name)
  176.     if length(matches) = 0 then
  177.     puts(SCREEN, "\n\tnot found\n")
  178.     end if 
  179.     for i = 1 to length(matches) do
  180.     show(SCREEN, database[matches[i]])
  181.     end for
  182. end procedure
  183.  
  184. procedure db_list(file_number f)
  185. -- list the entire database to a device
  186.     sequence sorted_database
  187.  
  188.     sorted_database = sort(database)
  189.     puts(f, '\n')
  190.     for i = 1 to length(sorted_database) do
  191.     show(f, sorted_database[i]) 
  192.     end for
  193. end procedure
  194.  
  195. procedure db_save()
  196. -- save in-memory database to disk file
  197.     system("copy " & DB_NAME & " " & BACK_NAME & " > NUL", 2)
  198.     db = open(DB_NAME, "w")
  199.     if db = -1 then
  200.     system("copy " & BACK_NAME & " " & DB_NAME & " > NUL", 2)
  201.     error("Can't save database")
  202.     end if
  203.     -- we could save space in the file by using puts() to output strings
  204.     -- like "ABC". print() outputs numbers like {65, 66, 67}
  205.     print(db, database)
  206.     close(db)
  207. end procedure
  208.  
  209. procedure db_create()
  210. -- create a new database
  211.      
  212.     db = open(DB_NAME, "w")
  213.     database = {}
  214.     print(db, database)
  215.     close(db)
  216.     db = open(DB_NAME, "r")
  217.     if db = -1 then
  218.     error("Couldn't open database")
  219.     end if    
  220. end procedure
  221.  
  222. procedure db_main()
  223.     sequence command
  224.     file_number printer
  225.  
  226.     db = open(DB_NAME, "r")
  227.     if db = -1 then
  228.     db_create()
  229.     else
  230.     database = get(db)
  231.     if database[1] != GET_SUCCESS then
  232.         error("Couldn't read database")
  233.     end if
  234.     database = database[2]
  235.     end if
  236.     close(db)
  237.  
  238.     clear_screen()
  239.     puts(SCREEN, "\t\tSimple Database\n")
  240.     while TRUE do
  241.     puts(SCREEN, 
  242.     "\n(a)dd, (d)elete, (f)ind, (l)ist, (p)rint, (s)ave, (q)uit: ")
  243.     command = user_input()
  244.     if find('a', command) then
  245.         db_add()
  246.  
  247.     elsif find('d', command) then
  248.         db_delete()
  249.  
  250.     elsif find('f', command) then
  251.         db_find()
  252.  
  253.     elsif find('q', command) then
  254.         exit
  255.  
  256.     elsif find('s', command) then
  257.         db_save()
  258.         exit
  259.  
  260.     elsif find('l', command) then
  261.         db_list(SCREEN)
  262.  
  263.     elsif find('p', command) then
  264.         printer = open("PRN", "w")
  265.         if printer = -1 then
  266.         puts(SCREEN, "Can't open printer device\n")
  267.         else
  268.         db_list(printer)
  269.         puts(printer, FORM_FEED)
  270.         close(printer)
  271.         end if
  272.     else
  273.         puts(SCREEN, "\nsay what?\n")                   
  274.     end if 
  275.     end while
  276. end procedure
  277.  
  278. db_main()
  279.  
  280.